| Filename | (eval 1149)[/usr/share/perl/5.10/CGI.pm:869] |
| Statements | Executed 74 statements in 584µs |
| Eval Invoked At | /usr/share/perl/5.10/CGI.pm line 869 |
| Sibling evals | 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23 |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 493µs | 2.85ms | CGI::header |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # spent 2.85ms (493µs+2.36) within CGI::header which was called:
# once (493µs+2.36ms) by C4::Output::output_with_http_headers at line 832 of CGI.pm | ||||
| 2 | 1 | 6µs | 1 | 12µs | my($self,@p) = self_or_default(@_); # spent 12µs making 1 call to CGI::self_or_default |
| 3 | 1 | 300ns | my(@header); | ||
| 4 | |||||
| 5 | 1 | 3µs | return "" if $self->{'.header_printed'}++ and $HEADERS_ONCE; | ||
| 6 | |||||
| 7 | 1 | 16µs | 1 | 497µs | my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = # spent 497µs making 1 call to CGI::Util::rearrange |
| 8 | rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], | ||||
| 9 | 'STATUS',['COOKIE','COOKIES'],'TARGET', | ||||
| 10 | 'EXPIRES','NPH','CHARSET', | ||||
| 11 | 'ATTACHMENT','P3P'],@p); | ||||
| 12 | |||||
| 13 | # Since $cookie and $p3p may be array references, | ||||
| 14 | # we must stringify them before CR escaping is done. | ||||
| 15 | 1 | 300ns | my @cookie; | ||
| 16 | 1 | 3µs | for (ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie) { | ||
| 17 | 2 | 25µs | 4 | 797µs | my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_; # spent 790µs making 2 calls to CGI::Cookie::as_string, avg 395µs/call
# spent 7µs making 2 calls to UNIVERSAL::isa, avg 4µs/call |
| 18 | 2 | 8µs | push(@cookie,$cs) if defined $cs and $cs ne ''; | ||
| 19 | } | ||||
| 20 | 1 | 600ns | $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY'; | ||
| 21 | |||||
| 22 | # CR escaping for values, per RFC 822 | ||||
| 23 | 1 | 2µs | for my $header ($type,$status,@cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) { | ||
| 24 | 14 | 16µs | if (defined $header) { | ||
| 25 | # From RFC 822: | ||||
| 26 | # Unfolding is accomplished by regarding CRLF immediately | ||||
| 27 | # followed by a LWSP-char as equivalent to the LWSP-char. | ||||
| 28 | 9 | 77µs | 18 | 27µs | $header =~ s/$CRLF(\s)/$1/g; # spent 19µs making 9 calls to CGI::CORE:regcomp, avg 2µs/call
# spent 9µs making 9 calls to CGI::CORE:subst, avg 956ns/call |
| 29 | |||||
| 30 | # All other uses of newlines are invalid input. | ||||
| 31 | 9 | 120µs | 18 | 44µs | if ($header =~ m/$CRLF|\015|\012/) { # spent 23µs making 9 calls to CGI::CORE:regcomp, avg 3µs/call
# spent 21µs making 9 calls to CGI::CORE:match, avg 2µs/call |
| 32 | # shorten very long values in the diagnostic | ||||
| 33 | $header = substr($header,0,72).'...' if (length $header > 72); | ||||
| 34 | die "Invalid header value contains a newline not followed by whitespace: $header"; | ||||
| 35 | } | ||||
| 36 | } | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | 1 | 900ns | $nph ||= $NPH; | ||
| 40 | |||||
| 41 | 1 | 500ns | $type ||= 'text/html' unless defined($type); | ||
| 42 | |||||
| 43 | 1 | 7µs | 1 | 25µs | if (defined $charset) { # spent 25µs making 1 call to CGI::charset |
| 44 | $self->charset($charset); | ||||
| 45 | } else { | ||||
| 46 | $charset = $self->charset if $type =~ /^text\//; | ||||
| 47 | } | ||||
| 48 | 1 | 700ns | $charset ||= ''; | ||
| 49 | |||||
| 50 | # rearrange() was designed for the HTML portion, so we | ||||
| 51 | # need to fix it up a little. | ||||
| 52 | 1 | 2µs | for (@other) { | ||
| 53 | # Don't use \s because of perl bug 21951 | ||||
| 54 | 4 | 44µs | 4 | 26µs | next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s; # spent 26µs making 4 calls to CGI::CORE:match, avg 6µs/call |
| 55 | 4 | 124µs | 16 | 490µs | ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e; # spent 422µs making 1 call to CGI::AUTOLOAD
# spent 48µs making 3 calls to CGI::unescapeHTML, avg 16µs/call
# spent 10µs making 4 calls to CGI::CORE:subst, avg 2µs/call
# spent 10µs making 8 calls to CGI::CORE:substcont, avg 1µs/call |
| 56 | } | ||||
| 57 | |||||
| 58 | 1 | 6µs | 1 | 900ns | $type .= "; charset=$charset" # spent 900ns making 1 call to CGI::CORE:match |
| 59 | if $type ne '' | ||||
| 60 | and $type !~ /\bcharset\b/ | ||||
| 61 | and defined $charset | ||||
| 62 | and $charset ne ''; | ||||
| 63 | |||||
| 64 | # Maybe future compatibility. Maybe not. | ||||
| 65 | 1 | 2µs | my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; | ||
| 66 | 1 | 300ns | push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph; | ||
| 67 | 1 | 200ns | push(@header,"Server: " . &server_software()) if $nph; | ||
| 68 | |||||
| 69 | 1 | 2µs | push(@header,"Status: $status") if $status; | ||
| 70 | 1 | 300ns | push(@header,"Window-Target: $target") if $target; | ||
| 71 | 1 | 200ns | push(@header,"P3P: policyref=\"/w3c/p3p.xml\", CP=\"$p3p\"") if $p3p; | ||
| 72 | # push all the cookies -- there may be several | ||||
| 73 | 1 | 68µs | push(@header,map {"Set-Cookie: $_"} @cookie); | ||
| 74 | # if the user indicates an expiration time, then we need | ||||
| 75 | # both an Expires and a Date header (so that the browser is | ||||
| 76 | # uses OUR clock) | ||||
| 77 | 1 | 400ns | push(@header,"Expires: " . expires($expires,'http')) | ||
| 78 | if $expires; | ||||
| 79 | 1 | 7µs | 1 | 116µs | push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph; # spent 116µs making 1 call to CGI::Util::expires |
| 80 | 1 | 12µs | 1 | 262µs | push(@header,"Pragma: no-cache") if $self->cache(); # spent 262µs making 1 call to CGI::AUTOLOAD |
| 81 | 1 | 400ns | push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment; | ||
| 82 | 1 | 7µs | push(@header,map {ucfirst $_} @other); | ||
| 83 | 1 | 2µs | push(@header,"Content-Type: $type") if $type ne ''; | ||
| 84 | 1 | 5µs | my $header = join($CRLF,@header)."${CRLF}${CRLF}"; | ||
| 85 | 1 | 1µs | if (($MOD_PERL >= 1) && !$nph) { | ||
| 86 | $self->r->send_cgi_header($header); | ||||
| 87 | return ''; | ||||
| 88 | } | ||||
| 89 | 1 | 12µs | return $header; | ||
| 90 | } | ||||
| 91 | |||||
| 92 | ; |